Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/swagd-f/findrepl.swg/0011_SEARCH.PAS.pas

Pascal/Delphi Source File | 1993-05-28 | 12.7 KB | 293 lines

Program search;
{$A+,B-,D-,E+,F-,I+,L-,N-,O-,R-,S-,V-}
{$M 16384,0,655360}


 { Copyright 1990 Trevor J Carlsen Version 1.05  24-07-90                    }
 { This Program may be used and distributed as if it was in the Public Domain}
 { With the following exceptions:                                            }
 {    1.  if you alter it in any way, the copyright notice must not be       }
 {        changed.                                                           }
 {    2.  if you use code excerpts in your own Programs, due credit must be  }
 {        given, along With a copyright notice -                             }
 {        "Parts Copyright 1990 Trevor J Carlsen"                            }
 {    3.  No Charge may be made For any Program using code from this Program.}

 { SEARCH will scan a File or group of Files and report on all occurrences   }
 { of a particular String or group of Characters. if found the search String }
 { will be displayed along With the 79 Characters preceding it and the 79    }
 { Characters following the line it is in.  Wild cards may be used in the    }
 { Filenames to be searched.                                                 }

 { if you find this Program useful here is the author's contact address -    }

 {      Trevor J Carlsen                                                     }
 {      PO Box 568                                                           }
 {      Port Hedland Western Australia 6721                                  }
 {      Voice 61 [0]91 72 2026                                               }
 {      Data  61 [0]91 72 2569                                               }



Uses
  Dos,
  tpString,  { Turbo Power's String handling library.  Procedures and        }
             { Functions used from this Unit are -                           }
             {       BMSearch       THESE ARE in THE SOURCE\MISC DIRECtoRY   }
             {       BMSearchUC                                              }
             {       BMMakeTable                                             }
             {       StUpCase                                                }
  tctimer;   { A little timing routine - not needed if lines (**) removed.   }

Const
  bufflen     = 65000;  { Do not increase this buffer size . Ok to decrease. }
  searchlen   = bufflen;
  copyright1  = 'SEARCH - version 1.05 Copyright 1990 Trevor Carlsen';
  copyright2  = 'All rights reserved.';

Type
  str79       = String[79];
  bufferType  = Array[0..bufflen] of Byte;
  buffptr     = ^bufferType;

Const
  space       = #32;
  quote       = #34;
  comma       = #44;
  CaseSensitive : Boolean = True;       { default is a Case sensitive search }
Var
  table       : BTable;                           { Boyer-Moore search table }
  buffer      : buffptr;                             { Pointer to new buffer }
  f           : File;
  DisplayStr  : Array[0..3] of str79;
  Filename,
  SrchStr     : String;
  Slen        : Byte Absolute SrchStr;

Procedure Asc2Str(Var s, ns; max: Byte);

  { Converts an Array of asciiz Characters to a turbo String                 }
  { For speed the Variable st is  effectively global and it is thereFore     }
  { vitally important that max is no larger than the ns unTyped parameter    }
  { Failure to ensure this can result in unpredictable Program behaviour     }

  Var stArray : Array[0..255] of Byte Absolute s;
      st      : String Absolute ns;
      len     : Byte Absolute st;

  begin
    move(stArray[0],st[1],max);
    len := max;
  end; { Asc2Str }

Procedure ReportError(e : Byte);
  { Displays a simple instruction screen in the event of insufficient        }
  { parameters or certain other errors                                       }
  begin
    Writeln('SYNTAX:');
    Writeln('SEARCH [-c] [path]Filename searchstr');
    Writeln(' eg:  SEARCH c:\comm\telix\salt.doc "color"');
    Writeln(' or');
    Writeln('      SEARCH c:\comm\telix\salt.doc 13,10,13,10,13,10,13,10');
    Writeln(' or');
    Writeln('      SEARCH -c c:\*.* "MicroSoft"');
    Writeln;
    Writeln('if the -c option is used then a Case insensitive search is used.');
    Writeln('When used the -c option must be the first parameter.');
    halt(e);
  end; { ReportError }

Procedure ParseCommandLine;
  { This Procedure is Really the key to everything as it parses the command  }
  { line to determine what the String being searched For is.  Because the    }
  { wanted String can be entered in literal Form or in ascii codes this will }
  { disect and determine the method used.                                    }

  Var
    parstr      : String;                        { contains the command line }
    len         : Byte Absolute parstr;{ will contain the length of cmd line }
    cpos, qpos,
    spos, chval : Byte;
    error       : Integer;

  begin { ParseCommandLine}
    parstr    := String(ptr(PrefixSeg,$80)^);         { Get the command line }
    if parstr[1] = space then
      delete(parstr,1,1);  { if the first Character is a space get rid of it }
    spos      := pos(space,parstr);                   { find the first space }
    if spos    = 0 then                   { No spaces which must be an error }
      ReportError(1);

    Filename  := StUpCase(copy(parstr,1,spos-1));  { Filename used as a temp }
    if pos('-C',Filename) = 1 then begin  { Case insensitive search required }
      CaseSensitive := False;
      delete(parstr,1,spos);                   { Get rid of the used portion }
    end; { if pos('-C' }
    spos      := pos(space,parstr);                        { find next space }
    if spos    = 0 then                   { No spaces which must be an error }
      ReportError(1);
    Filename  := StUpCase(copy(parstr,1,spos-1));        { Get the File mask }
    delete(parstr,1,spos);                     { Get rid of the used portion }

    qpos      := pos(quote,parstr);          { look For the first quote Char }
    if qpos   <> 0 then begin    { quote Char found - so must be quoted Text }
      if parstr[1] <> quote then ReportError(2);  { first Char must be quote }
      delete(parstr,1,1);                       { get rid of the first quote }
      qpos      := pos(quote,parstr);              { and find the next quote }
      if qpos = 0 then ReportError(3);  { no more quotes - so it is an error }
      SrchStr   := copy(parstr,1,qpos-1);        { search String now defined }
    end  { if qpos <> 0 }

    else begin                                   { must be using ascii codes }
      Slen      := 0;
      cpos      := pos(comma,parstr);                     { find first comma }
      if cpos = 0 then cpos := succ(len);{ No comma - so only one ascii code }
      Repeat                                      { create the search String }
        val(copy(parstr,1,pred(cpos)),chval,error);
        if error <> 0 then ReportError(7);   { there is an error so bomb out }
        inc(Slen);
        SrchStr[Slen] := Char(chval);        { add Char to the search String }
        delete(parstr,1,cpos);           { get rid of used portion of parstr }
        cpos  := pos(comma,parstr);                    { find the next comma }
        if cpos = 0 then cpos := succ(len);    { no more commas so last Char }
      Until len = 0;              { Until whole of command line is processed }
    end; { else}

    if not CaseSensitive then       { change the Search String to upper Case }
      SrchStr := StUpCase(SrchStr);
  end; { ParseCommandLine }

Function OpenFile(ofn : String): Boolean;  { open a File For BlockRead/Write }
  Var
    error : Word;
  begin { OpenFile}
    assign(f,ofn);
    {$I-} reset(f,1); {$I+}
    error := Ioresult;
    if error <> 0 then
      Writeln('Cannot open ',ofn);
    OpenFile := error = 0;
  end; { OpenFile }

Procedure CloseFile;
  begin
    {$I-}
    Close(f);
    if Ioresult <> 0 then;    { don't worry too much if an error occurs here }
    {$I+}
  end; { CloseFile }

Procedure SearchFile(Var Filename: String);
  { Reads a File into the buffer and then searches that buffer For the wanted}
  { String or Characters.                                                    }
  Var
    x,y,
    count,
    result,
    bufferpos   : Word;
    abspos      : LongInt;
    finished    : Boolean;

  begin  { SearchFile}
    BMMakeTable(SrchStr,table);          { Create a Boyer-Moore search table }
    new(buffer);                     { make room on the heap For the buffers }
    {$I-} BlockRead(f,buffer^,searchlen,result); {$I+}  { Fill buffer buffer }
    if Ioresult <> 0 then begin      { error occurred While reading the File }
      CloseFile;
      ReportError(11);
    end; { if Ioresult }
    abspos       := 0;        { Initialise the Absolute File position marker }
    Repeat
      bufferpos      := 0;               { position marker in current buffer }
      count          := 0;               { offset from search starting point }
      finished := (result < searchlen);    { if buffer <> full no more reads }

      Repeat                              { Do a BM search For search String }
        if CaseSensitive then                   { do a Case sensitive search }
          count:=BMSearch(buffer^[bufferpos],result-bufferpos,table,SrchStr)
        else                                  { do a Case insensitive search }
          count:=BMSearchUC(buffer^[bufferpos],result-bufferpos,table,SrchStr);

        if count <> $FFFF then begin                   { search String found }
          inc(bufferpos,count);        { starting point of SrchStr in buffer }
          DisplayStr[0] := HexL(abspos+bufferpos) +    { hex and decimal pos }
                           Form('  @######',(abspos+bufferpos) * 1.0);
          if bufferpos > 79 then          { there is a line available beFore }
            Asc2Str(buffer^[bufferpos - 79],DisplayStr[1],79)
          else                          { no line available beFore the found }
            DisplayStr[1] := '';               { position so null the String }
          if (bufferpos + 79) < result then       { at least 79 Chars can be }
            Asc2Str(buffer^[bufferpos],DisplayStr[2],79)         { displayed }
          else                         { only display what is left in buffer }
            Asc2Str(buffer^[bufferpos],DisplayStr[2],result - bufferpos);
          if (bufferpos + 158) < result then    { display the line following }
            Asc2Str(buffer^[bufferpos + 79],DisplayStr[3],79)
          else                          { no line following the found String }
            DisplayStr[3] := '';                { so null the display String }
          Writeln;
          Writeln(DisplayStr[0],'   ',Filename);{ display the File locations }

          For x := 1 to 3 do begin
            For y := 1 to length(DisplayStr[x]) do{ filter out non-printables}
              if ord(DisplayStr[x][y]) < 32 then DisplayStr[x][y] := '.';
            if length(DisplayStr[x]) <> 0 then   { only display Strings With }
               Writeln(DisplayStr[x]);                       { valid content }
          end; { For x }

          inc(bufferpos,Slen);         { no need to check buffer in found st }
        end;  { if count <> $ffff }

      Until (bufferpos >= (result-length(SrchStr))) or (count = $ffff);

      if not finished then begin       { Fill 'er up again For another round }
        inc(abspos,result - Slen);      { create overlap so no String missed }
        {$I-} seek(f,abspos);
        BlockRead(f,buffer^,searchlen,result); {$I+}
        if Ioresult <> 0 then begin
          CloseFile;
          ReportError(13);
        end;
      end; { if not finished}
    Until finished;
    dispose(buffer);
  end; { SearchFile }

Procedure SearchForFiles;
  Var
    dirinfo : SearchRec;
    FullName: PathStr;
    DirName : DirStr;
    FName   : NameStr;
    ExtName : ExtStr;
    found   : Boolean;
  begin
    FindFirst(Filename,AnyFile,dirinfo);
    found := DosError = 0;
    if not found then begin
      Writeln('Cannot find ',Filename);
      ReportError(255);
    end;
    FSplit(Filename,DirName,FName,ExtName);
    While found do begin
      if (dirinfo.Attr and 24) = 0 then begin
        FullName := DirName + dirinfo.name;
        if OpenFile(FullName) then begin
          SearchFile(FullName);
          CloseFile;
        end;
      end;
      FindNext(dirinfo);
      found := DosError = 0;
    end;
  end; { SearchForFiles }

begin { main}
  (**) StartTimer;
  Writeln(copyright1);
  Writeln(copyright2);
  ParseCommandLine;
  SearchForFiles;
  (**) WriteElapsedTime;
end.